home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / apps / 131 / applic / tinyustf.pas < prev    next >
Pascal/Delphi Source File  |  1987-04-17  |  4KB  |  160 lines
  1. PROGRAM TinyUnstuff;  {Tiny to Neo format unstuffer. By Carlos Reyes}
  2.  
  3. CONST
  4.     Read_Only = 0;
  5.  
  6. TYPE
  7.     inbufType = PACKED ARRAY[1..32044] OF BYTE;
  8.     outbufType = PACKED ARRAY[1..32128] OF BYTE;
  9.     Path_Chars = PACKED ARRAY[1..80] OF CHAR;
  10.  
  11. VAR
  12.     f :Integer;
  13.     inbuf :inbufType;
  14.     outbuf :outbufType;
  15.     picname :String[80];
  16.     name :Path_Chars;
  17.     i :Integer;
  18.  
  19.  
  20. FUNCTION f_create(VAR name :Path_Chars; attributes :Integer) :Integer;
  21.     GemDos($3c);
  22.  
  23. FUNCTION f_open(VAR name :Path_Chars; mode :Integer ) :Integer;
  24.     GemDos($3d);
  25.  
  26. FUNCTION f_close(handle :Integer) :Integer;
  27.     GemDos($3e);
  28.  
  29. FUNCTION f_read(handle :Integer; count :Long_Integer;
  30.                 VAR buffer :inbufType) :Long_Integer;
  31.     GemDos($3f);
  32.  
  33. FUNCTION f_write( handle :Integer; count :Long_Integer;
  34.                   VAR buffer :outbufType) :Long_Integer;
  35.     GemDos($40);
  36.  
  37.  
  38. PROCEDURE Error;
  39. BEGIN
  40.     Writeln;
  41.     Writeln('Error!!!');
  42.     Write('Press RETURN to exit: ');
  43.     Readln;
  44.     Halt;
  45.     END;
  46.  
  47.  
  48. PROCEDURE DecodePic;
  49. VAR
  50.     rotInfo :BOOLEAN;
  51.     res :INTEGER;
  52.     i, j :INTEGER;
  53.     curplane, curln, curcol :Integer;
  54.     ctrlptr, dataptr :Integer;
  55.     ctrlcnt, datacnt :Integer;
  56.  
  57.  
  58.     PROCEDURE PutWord;
  59.     VAR pos :Integer;
  60.     BEGIN
  61.         pos:=ShL(curplane,1)+curln*160+ShL(curcol,3);
  62.         outbuf[129+pos]:=inbuf[dataptr];
  63.         outbuf[129+pos+1]:=inbuf[dataptr+1];
  64.         curln:=curln+1;
  65.         IF curln>=200 THEN BEGIN
  66.             curln:=0;
  67.             curcol:=curcol+1;
  68.             IF curcol>=20 THEN BEGIN
  69.                 curcol:=0;
  70.                 curplane:=curplane+1;
  71.                 Write('.');
  72.                 END
  73.             END
  74.         END;
  75.  
  76.  
  77. BEGIN
  78.     FOR i:=1 TO 128 DO outbuf[i]:=0;
  79.  
  80.     res :=inbuf[1];
  81.     rotInfo:=True;
  82.     IF res>2 THEN res:=res-3 ELSE rotInfo:=False;
  83.     outbuf[4]:=res;
  84.  
  85.     Write('Resolution: ');
  86.     IF res=0 THEN Writeln('Low')
  87.         ELSE IF res=1 THEN Writeln('Medium')
  88.         ELSE Writeln('High');
  89.  
  90.     ctrlptr:=2;
  91.     IF rotInfo THEN ctrlptr:=ctrlptr+4;
  92.     FOR i:=1 TO 32 DO
  93.         outbuf[i+4]:=inbuf[ctrlptr+i-1];
  94.     ctrlptr:=ctrlptr+32;
  95.  
  96.     ctrlcnt:=ShL(inbuf[ctrlptr],8)+inbuf[ctrlptr+1];
  97.     datacnt:=ShL(inbuf[ctrlptr+2],8)+inbuf[ctrlptr+3];
  98.     ctrlptr:=ctrlptr+4;
  99.     dataptr:=ctrlptr+ctrlcnt;
  100.     curplane:=0; curln:=0; curcol:=0;
  101.  
  102.     REPEAT
  103.         IF inbuf[ctrlptr]>=128 THEN BEGIN
  104.             FOR j:=1 TO (256-inbuf[ctrlptr]) DO BEGIN
  105.                 PutWord;
  106.                 dataptr:=dataptr+2;
  107.                 END;
  108.             ctrlptr:=ctrlptr+1;
  109.             END
  110.    else IF inbuf[ctrlptr]=0 THEN BEGIN
  111.             FOR j:=1 TO (inbuf[ctrlptr+1]*256+inbuf[ctrlptr+2]) DO
  112.                 PutWord;
  113.             ctrlptr:=ctrlptr+3;
  114.             dataptr:=dataptr+2;
  115.             END
  116.    else IF inbuf[ctrlptr]=1 THEN BEGIN
  117.             FOR j:=1 TO (inbuf[ctrlptr+1]*256+inbuf[ctrlptr+2]) DO BEGIN
  118.                 PutWord;
  119.                 dataptr:=dataptr+2;
  120.                 END;
  121.             ctrlptr:=ctrlptr+3;
  122.             END
  123.    else BEGIN
  124.             FOR j:=1 TO inbuf[ctrlptr] DO    {inbuf[ctrlptr]>1}
  125.                 PutWord;
  126.             ctrlptr:=ctrlptr+1;
  127.             dataptr:=dataptr+2;
  128.             END;
  129.         UNTIL (curplane>=4);
  130.         Writeln;
  131.     END;
  132.  
  133.  
  134. BEGIN
  135.     Writeln('Tiny to Neo format converter.');
  136.     Writeln;
  137.     Write('Name of Tiny picture: ');
  138.     Readln(picname);
  139.     FOR i:=1 to Length(picname) DO  name[i]:=picname[i];
  140.     name[ Length(picname)+1 ]:=Chr(0);
  141.     f:=f_open(name, Read_Only);
  142.     IF f < 0 THEN Error;
  143.     Write('Reading picture...');
  144.     IF f_read(f, 32044, inbuf) < 42 THEN Error;
  145.     IF f_close(f) < 0 THEN Error;
  146.     Writeln;
  147.     Writeln('Decoding picture...');
  148.     DecodePic;
  149.     Delete(picname, Length(picname)-3, 4);
  150.     picname := Concat(picname, '.neo');
  151.     FOR i:=1 to Length(picname) DO  name[i]:=picname[i];
  152.     name[ Length(picname)+1 ]:=Chr(0);
  153.     f:=f_create(name, 0);
  154.     IF f < 0 THEN Error;
  155.     Write('Writing picture...');
  156.     IF f_write(f, 32128, outbuf) <> 32128 THEN Error;
  157.     IF f_close(f) < 0 THEN Error;
  158.     Writeln;
  159.     END.
  160.